home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 July / Macworld (1999-07).dmg / Shareware World / Info / For Developers / Mops 3.4.sea / Mops source / Module source / zInstlmod.txt < prev    next >
Text File  |  1998-09-24  |  5KB  |  221 lines
  1. \ Install - PowerMops version.
  2.  
  3. \ Dec 97        Initial version.
  4.  
  5. \ need    window+
  6.  
  7. \ konst resLocked        constant    LOCKED
  8. \ konst resPurgeable    constant    PURGEABLE
  9.  
  10. syscall HCreateResFile
  11. syscall CloseResFile
  12. syscall HOpenResFile
  13.  
  14.  
  15.     0    value        CURSTACK
  16.     0    value        CURDICT
  17.  
  18.     0    value        HEAPAVAIL
  19. false    value        GOTFREE?
  20. true    value        SAVE?
  21.  
  22.     0    value        QUITWORD
  23.     0    value        ABORTWORD
  24.  
  25.     string        $TMP
  26.  
  27.     int        APREFNUM
  28.     var        APPARAM
  29.  
  30. 23    dialog        IDLG
  31.  
  32.  
  33. : NOGO    3 beep  3 beep  close: iDlg  set: fWind
  34.     cr ." Res error# " .
  35.     cr ." Type any key to return to Finder, hopefully"
  36.     key  bye  ;
  37.  
  38.  
  39.  
  40. \ : !STACK    curStack -> stkSpace  ;
  41.  
  42. \ : @HEAP        \ Returns starting heap size for this nucleus.
  43. \    gotFree?  NIF  free  -> heapAvail  true -> gotFree?  THEN
  44. \    heapAvail  ;
  45.  
  46. \ : CURHEAP        \ Computes amount of heap available for current configuration.
  47. \    @heap  stkspace curStack - +  room curDict - +  ;
  48.  
  49. \ : SETMEM        \ Sets nucleus stack to selected values
  50. \    !stack
  51. \    curDict -> maxdic  ;
  52.  
  53. : iMsg        \ ( addr1 len1 addr2 len2 -- )  Gives informatory message
  54.     "  " "  " ParamText draw: iDlg  ;
  55.  
  56. : ChR        \ ( handle -- handle )  Marks the resource for update to disk
  57.     dup ChangedResource  ;
  58.  
  59.  
  60. : INVWORD        \ ( item# -- )
  61.     40 beep  0  $ ffff rot  setSelect: iDlg  ReturnToModal  ;
  62.  
  63. : OK        \ Validates quits & abort words; if bad returns to modal
  64.     23 getItem: iDlg
  65.     NIF            \ not shared library - check start word
  66.         10 getText: iDlg  sFind  NIF  10 invWord  EXIT  THEN
  67.         -> quitword
  68.     THEN
  69.     11 getText: iDlg  sFind  NIF  11 invWord  EXIT  THEN
  70.     -> abortword
  71.     true  ;
  72.  
  73. : CANCEL    false  ;
  74.  
  75. : sharedLibItem
  76.     togitem
  77.     23 getitem: iDlg
  78.     IF        3 hideitem: iDlg  15 hideitem: iDlg
  79.             10 hideitem: iDlg  19 hideitem: iDlg
  80.     ELSE    3 showitem: iDlg  15 showitem: iDlg
  81.             10 showitem: iDlg  19 showitem: iDlg
  82.     THEN
  83. ;
  84.  
  85. xts{    ok cancel null null null null null null null null null
  86.         togitem togItem togItem null null null null null null null
  87.         togitem sharedLibItem  }
  88.     111  init: iDlg   1  setBold: iDlg
  89.  
  90. : GETR
  91.     get_appl_name ->: $tmp  all: $tmp  5  putText: iDlg
  92.     get_appl_vers ->: $tmp  all: $tmp  4  putText: iDlg
  93.     get_appl_sig  pad !  pad 4  3  putText: iDlg  ;
  94.  
  95. : DROP@        \ ( addr len -- addr' )
  96.         \ Fetches 1st four bytes on an odd byte, pad with blanks
  97.     >r sp@ $ 20202020 rot rot r> 4 min cmove  ;
  98.  
  99. : SETFREF        \ ( type n -- )
  100.     'type FREF  swap  set: srcRes  getNew: srcRes
  101.     get: srcRes  ChR  >ptr !  ;
  102.  
  103.  
  104.  
  105. scon    $ALQ    "alert%"    & %  & "  instead
  106.  
  107. 0        value    currVref
  108.  
  109.  
  110. : NEW_APPLICATION  { \ sig addr len fRefNum -- }
  111.         \ This word does all the hard work of creating the
  112.         \ installed application file.  For PowerMops, it's a glorified
  113.         \ version of SAVEDIC in zFEmod.
  114.  
  115.     5 getText: iDlg  -> len -> addr
  116.  
  117.     23 getItem: iDlg
  118.     IF                            \ it's a shared library
  119.         true -> shared_lib?
  120.         " Save shared library as:"
  121.     ELSE
  122.         " Save installed application as:"
  123.     THEN
  124.     addr len
  125.     stdPut: fFcb  0EXIT                    \ out if user cancelled
  126.  
  127.     getVref: fFcb  -> currVref
  128.     getName: fFcb  -> len  -> addr        \ name may have changed
  129.  
  130. \ now we can't just use  create: ffcb, since that method just opens the
  131. \  file if it already exists, and when we try to write the resources we'll
  132. \  get an error since they're there already.  We have to actually delete
  133. \  the file in this situation.
  134.  
  135.     open: ffcb
  136.     NIF            \ no error - i.e. it exists
  137.         close: ffcb drop
  138.         delete: ffcb  OK?
  139.     THEN
  140.  
  141.     create: ffcb  OK?
  142.     shared_lib?
  143.     IF
  144.         'type cfmg  -> sig
  145.         'type shlb
  146.     ELSE
  147.         3  getText: iDlg  drop@ -> sig        \ New sig
  148.         'type APPL
  149.     THEN
  150.     sig  set: ffcb                        \ Set type & sig of appl
  151.     $ 21  addr: ffcb $ 28 + c!            \ Set Bundle bit
  152.     setFileInfo: ffcb  OK?
  153.  
  154.     currVRef  0  addr len str255  HCreateResFile  drop resChk
  155.     currVref  0  buf255  0  HOpenResFile  -> fRefNum  resChk
  156.  
  157. \ now the res fork should be still open, so we add the other resources:
  158.  
  159.     13 getitem: iDlg
  160.     IF    true -> fWind?                    \ fWind? wanted - copy it (WIND 256)
  161.         'type WIND  256  copyRes
  162.         12 getitem: iDlg  8 <<  ptr: dstRes 10 + w!
  163.                                         \ Mark visible or not
  164.     ELSE
  165.         false -> fWind?
  166.     THEN
  167.  
  168.     'type BNDL  129  copyRes            \ and don't drop our BNDL (129)
  169.     sig  ptr: dstRes  !                    \ Store in new BNDL
  170.     
  171. \ Now set up FREFs:
  172.  
  173.     'type FREF  128  copyRes            \ FREF for APPL - doesn't change
  174.     10 6 DO                                \ FREFs 129 onwards
  175.         i getText: iDlg  dup
  176.         NIF  drop  LEAVE  THEN
  177.         'type FREF  123 i +  copyRes
  178.         drop@  ptr: dstRes  !
  179.     LOOP
  180.     
  181. \ Now we create the new version resource which has a "type" that is the
  182. \ same as the sig, and ID 0.
  183.  
  184.     sig  0  set: dstRes
  185.     4 getText: iDlg  dup 1+ align  new: dstRes
  186.     str255  ptr: dstRes  over  c@ 1+ cMove
  187.     nullOSstr  addRes: dstRes
  188.     
  189. \ Now copy the Alert" stuff if we need it
  190.  
  191.     $alq sfind nip
  192.     IF    'type ALRT  900  copyRes
  193.         'type DITL  900  copyRes
  194.     THEN
  195.  
  196.     quitword -> quitVec        \ startup word
  197.     abortword -> abortVec    \ error word
  198.  
  199.     true  true  (wp)        \ true = res fork open, true = installing
  200.     
  201.     fRefNum  CloseResFile
  202.     close: ffcb  drop
  203.     bye                        \ we don't try to keep running since we've
  204. ;                            \  changed vectors.  We could, but it's not
  205.                             \  worth the bother, and anyway we don't do
  206.                             \  it in the 68k version.
  207.  
  208.  
  209. : INSTALLWIND
  210.     openMR
  211.     getnew: iDlg   getR
  212.     21 hideItem: iDlg                \ PowerMops doesn't use this one
  213.     " go"     10 putText: iDlg
  214.     " crash" 11 putText: iDlg
  215.     0 $ ffff 3 setSelect: iDlg
  216.     arrowCurs
  217.     modal: iDlg
  218.     IF    new_application  THEN        \ will quit unless they cancel
  219.     close: iDlg
  220. ;
  221.